﻿Option Strict On
Imports System.Data.OleDb
Imports System.IO
Imports ADOX
Imports Microsoft.Office.Interop
Imports OleDbConnection = System.Data.OleDb.OleDbConnection

Module 手集計

#Region "DB新規作成・削除・閉じる テーブル"
    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    'MyDB新規作成
    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    Public Sub Db新規作成(ByVal Mydb As String)
        If String.IsNullOrWhiteSpace(Mydb) Then
            Throw New ArgumentException("Mydb に有効なパスを指定してください。", NameOf(Mydb))
        End If

        Try
            ' 既存ファイルの削除前に COM オブジェクトを強制解放
            If File.Exists(Mydb) Then
                ' 1. Access プロセスを強制終了
                Try
                    Dim accessProcesses = Process.GetProcessesByName("MSACCESS")
                    For Each proc In accessProcesses
                        Try
                            proc.Kill()
                            proc.WaitForExit(2000)
                        Catch
                        End Try
                    Next
                Catch
                End Try

                ' 2. ガベージコレクションを強制実行
                For i As Integer = 1 To 2
                    GC.Collect()
                    GC.WaitForPendingFinalizers()
                Next

                ' 3. ロックファイル (.laccdb) を削除
                Dim lockFile As String = Path.ChangeExtension(Mydb, ".laccdb")
                If File.Exists(lockFile) Then
                    Try
                        File.Delete(lockFile)
                    Catch
                        ' ロックファイルの削除失敗は無視
                    End Try
                End If

                System.Threading.Thread.Sleep(1000)

                ' 4. データベースファイル削除をリトライ
                Dim deleted As Boolean = False
                For i As Integer = 1 To 5
                    Try
                        File.Delete(Mydb)
                        deleted = True
                        Exit For
                    Catch ex As IOException
                        If i < 5 Then
                            System.Threading.Thread.Sleep(1000)
                            GC.Collect()
                            GC.WaitForPendingFinalizers()
                        Else
                            ' 最終的に失敗した場合、詳細なエラーメッセージを表示
                            Throw New IOException(
                                $"データベースファイルを削除できません。{vbCrLf}" &
                                $"パス: {Mydb}{vbCrLf}" &
                                $"以下を確認してください:{vbCrLf}" &
                                $"1. Accessアプリケーションが開いていないか{vbCrLf}" &
                                $"2. エクスプローラーでファイルを開いていないか{vbCrLf}" &
                                $"3. 他のプログラムがファイルを使用していないか{vbCrLf}" &
                                $"元のエラー: {ex.Message}", ex)
                        End If
                    End Try
                Next
            End If

            ' ADOX.Catalog のインスタンス生成
            ' ※参照設定で「Microsoft ADO Ext. x.x for DDL and Security」が必要です
            Dim cat As Object = CreateObject("ADOX.Catalog")

            Try
                Dim connStr As String = $"Provider=Microsoft.ACE.OLEDB.12.0;Data Source={Mydb};"
                ' データベース作成
                CallByName(cat, "Create", CallType.Method, connStr)
            Finally
                ' COM オブジェクトの確実な解放
                If cat IsNot Nothing Then
                    System.Runtime.InteropServices.Marshal.ReleaseComObject(cat)
                    cat = Nothing
                End If
            End Try

        Catch ex As Exception
            ' 呼び出し元へエラーを再送
            Throw
        End Try

    End Sub
    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    ' MyDBのファイルサイズがSaizu(MB)以上であればAccessデータベースを最適化する
    '＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
    Public Sub Access最適化(MyDB As String, Saizu As Integer)
        If Not File.Exists(MyDB) Then Exit Sub

        Dim fi As New FileInfo(MyDB)
        If fi.Length < CLng(Saizu) * 1024L * 1024L Then Exit Sub

        Dim tempPath As String = MyDB & ".tmp"
        Try
            Dim compacted As Boolean = False

            ' Try JRO (Jet Replication Objects)
            Dim jro As Object = Nothing
            Try
                jro = CreateObject("JRO.JetEngine")
                Dim args As Object() = {
                    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyDB,
                    "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & tempPath
                }
                jro.GetType().InvokeMember("CompactDatabase",
                    Reflection.BindingFlags.InvokeMethod,
                    Nothing, jro, args)
                compacted = True
            Catch
                ' ignore and try DAO below
            Finally
                If jro IsNot Nothing Then
                    Try
                        System.Runtime.InteropServices.Marshal.ReleaseComObject(jro)
                    Catch
                    End Try
                    jro = Nothing
                End If
            End Try

            ' Fallback: try DAO compact (if available)
            If Not compacted Then
                Try
                    Dim dbe As Object = CreateObject("DAO.DBEngine.120")
                    ' DAO.CompactDatabase requires source and destination paths
                    Dim args As Object() = {MyDB, tempPath}
                    dbe.GetType().InvokeMember("CompactDatabase",
                        Reflection.BindingFlags.InvokeMethod,
                        Nothing, dbe, args)
                    compacted = True
                    Try
                        System.Runtime.InteropServices.Marshal.ReleaseComObject(dbe)
                    Catch
                    End Try
                    dbe = Nothing
                Catch
                    ' ignore, will raise error below if not compacted
                End Try
            End If

            If Not compacted Then
                Throw New Exception("データベースの最適化に失敗しました。JRO/DAO コンポーネントが利用できないか、プロバイダのビット数が一致していない可能性があります。")
            End If

            File.Delete(MyDB)
            File.Move(tempPath, MyDB)
        Catch ex As Exception
            If File.Exists(tempPath) Then File.Delete(tempPath)
            MsgBox("Access最適化エラー: " & ex.Message)
        End Try
    End Sub

    ''' <summary>
    ''' 指定テーブルの列名を変更します。まず ADOX で列名を直接変更し、失敗した場合は
    ''' ALTER TABLE で新しい列を追加してコピー、旧列を削除するフォールバックを行います。
    ''' </summary>
    Public Sub Rename判定ToE判定()
        Dim tableName As String = "T160_全出荷E集計"
        If String.IsNullOrWhiteSpace(MyDB) Then
            MsgBox("DBパス未設定のため列名変更を中止します。")
            Return
        End If

        Dim cat As ADOX.Catalog = Nothing
        Try
            cat = New ADOX.Catalog()
            cat.let_ActiveConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyDB & ";")

            Dim tbl As ADOX.Table = Nothing
            For i As Integer = 0 To cat.Tables.Count - 1
                If String.Equals(cat.Tables(i).Name, tableName, StringComparison.OrdinalIgnoreCase) Then
                    tbl = cat.Tables(i)
                    Exit For
                End If
            Next

            If tbl Is Nothing Then
                MsgBox("テーブル '" & tableName & "' が見つかりません。")
                Return
            End If

            Dim hasOld As Boolean = False
            Dim hasNew As Boolean = False
            For j As Integer = 0 To tbl.Columns.Count - 1
                Dim cname As String = tbl.Columns(j).Name
                If String.Equals(cname, "判定", StringComparison.OrdinalIgnoreCase) Then hasOld = True
                If String.Equals(cname, "E判定", StringComparison.OrdinalIgnoreCase) Then hasNew = True
            Next

            If hasNew Then
                ' 既にE判定があるので何もしない
                Return
            End If

            If hasOld Then
                Try
                    ' ADOX で直接変更を試みる
                    tbl.Columns.Item("判定").Name = "E判定"
                    MsgBox("列名を '判定' -> 'E判定' に変更しました。")
                    Return
                Catch ex As Exception
                    ' フォールバックへ
                End Try
            Else
                MsgBox("列 '判定' が見つかりません。")
                Return
            End If

            ' フォールバック: 新列追加、値コピー、旧列削除
            Try
                Using cn As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyDB & ";")
                    cn.Open()
                    Using addCmd As New OleDbCommand("ALTER TABLE [" & tableName & "] ADD COLUMN [E判定] TEXT(10)", cn)
                        addCmd.ExecuteNonQuery()
                    End Using
                    Using updCmd As New OleDbCommand("UPDATE [" & tableName & "] SET [E判定] = [判定]", cn)
                        updCmd.ExecuteNonQuery()
                    End Using
                    Using dropCmd As New OleDbCommand("ALTER TABLE [" & tableName & "] DROP COLUMN [判定]", cn)
                        dropCmd.ExecuteNonQuery()
                    End Using
                    cn.Close()
                End Using
                MsgBox("フォールバックにより '判定' を 'E判定' に移行しました。")
            Catch ex As Exception
                MsgBox("列名変更に失敗しました: " & ex.Message)
            End Try

        Catch ex As Exception
            MsgBox("Rename 判定 -> E判定 エラー: " & ex.Message)
        Finally
            ReleaseCom(cat)
        End Try
    End Sub

    ''' <summary>
    ''' T160_全出荷I集計 テーブルの列名 '判定' を 'I判定' に変更します。
    ''' ADOXで直接リネームを試み、失敗した場合はフォールバックで新列追加・コピー・旧列削除を行います。
    ''' </summary>
    Public Sub Rename判定ToI判定()
        Dim tableName As String = "T160_全出荷I集計"
        If String.IsNullOrWhiteSpace(MyDB) Then
            MsgBox("DBパス未設定のため列名変更を中止します。")
            Return
        End If

        Dim cat As ADOX.Catalog = Nothing
        Try
            cat = New ADOX.Catalog()
            cat.let_ActiveConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyDB & ";")

            Dim tbl As ADOX.Table = Nothing
            For i As Integer = 0 To cat.Tables.Count - 1
                If String.Equals(cat.Tables(i).Name, tableName, StringComparison.OrdinalIgnoreCase) Then
                    tbl = cat.Tables(i)
                    Exit For
                End If
            Next

            If tbl Is Nothing Then
                MsgBox("テーブル '" & tableName & "' が見つかりません。")
                Return
            End If

            Dim hasOld As Boolean = False
            Dim hasNew As Boolean = False
            For j As Integer = 0 To tbl.Columns.Count - 1
                Dim cname As String = tbl.Columns(j).Name
                If String.Equals(cname, "判定", StringComparison.OrdinalIgnoreCase) Then hasOld = True
                If String.Equals(cname, "I判定", StringComparison.OrdinalIgnoreCase) Then hasNew = True
            Next

            If hasNew Then
                ' 既に I判定 があるので何もしない
                Return
            End If

            If hasOld Then
                Try
                    tbl.Columns.Item("判定").Name = "I判定"
                    MsgBox("列名を '判定' -> 'I判定' に変更しました。")
                    Return
                Catch ex As Exception
                    ' フォールバックへ
                End Try
            Else
                MsgBox("列 '判定' が見つかりません。")
                Return
            End If

            ' フォールバック: 新列追加、値コピー、旧列削除
            Try
                Using cn As New OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyDB & ";")
                    cn.Open()
                    Using addCmd As New OleDbCommand("ALTER TABLE [" & tableName & "] ADD COLUMN [I判定] TEXT(10)", cn)
                        addCmd.ExecuteNonQuery()
                    End Using
                    Using updCmd As New OleDbCommand("UPDATE [" & tableName & "] SET [I判定] = [判定]", cn)
                        updCmd.ExecuteNonQuery()
                    End Using
                    Using dropCmd As New OleDbCommand("ALTER TABLE [" & tableName & "] DROP COLUMN [判定]", cn)
                        dropCmd.ExecuteNonQuery()
                    End Using
                    cn.Close()
                End Using
                MsgBox("フォールバックにより '判定' を 'I判定' に移行しました。")
            Catch ex As Exception
                MsgBox("列名変更に失敗しました: " & ex.Message)
            End Try

        Catch ex As Exception
            MsgBox("Rename 判定 -> I判定 エラー: " & ex.Message)
        Finally
            ReleaseCom(cat)
        End Try
    End Sub
    Public Sub Access閉じる(MyDB1 As String)
        Dim targetFileName As String = MyDB1
        Dim accessApp As Access.Application = Nothing

        Try
            accessApp = DirectCast(System.Runtime.InteropServices.Marshal.GetActiveObject("Access.Application"), Access.Application)

            If accessApp.CurrentProject.Name = targetFileName Then
                accessApp.Quit()
                Console.WriteLine($"{targetFileName} を終了しました。")
            End If

        Catch ex As System.Runtime.InteropServices.COMException
            ' Accessが起動していない場合は何もしない
        Finally
            If accessApp IsNot Nothing Then
                System.Runtime.InteropServices.Marshal.ReleaseComObject(accessApp)
            End If
        End Try
    End Sub
    Public Sub Access接続を確実に閉じる(MyDB As String)
        ' インポートの直前にこれを徹底してください
        GC.Collect()
        GC.WaitForPendingFinalizers()

        ' CreateObjectを使用してインスタンス化
        Dim accessApp As Access.Application = DirectCast(CreateObject("Access.Application"), Access.Application)
        Try
            ' OpenCurrentDatabase の前にファイルが存在し、ロックされていないか確認
            ' 排他モード(Exclusive:=False)で開くことで衝突を避ける
            accessApp.OpenCurrentDatabase(MyDB, Exclusive:=False)

            ' ... インポート処理 ...
        Catch ex As Exception
            ' エラー詳細を表示
            Console.WriteLine("実行エラー: " & ex.Message)
        Finally
            accessApp.Quit()
            System.Runtime.InteropServices.Marshal.ReleaseComObject(accessApp)
        End Try

    End Sub

#End Region

#Region "テーブル 作成・削除・項目追加・削除"

    ''' <summary>
    ''' Accessテーブルに新しい列を追加します。
    ''' </summary>
    Public Sub 列を追加(dbPath As String, テーブル名 As String, 列名 As String, データ型 As String)

        '<param name="dbPath">Accessファイルへのフルパス</param>
        '<param name="テーブル名">対象のテーブル名</param>
        '<param name="列名">追加したい新しい列名</param>
        '<param name="データ型">String, Double, Integer など</param>
        '
        '接続文字列（accdb形式用）
        Dim connStr As String = $"Provider=Microsoft.ACE.OLEDB.12.0;Data Source={dbPath};"

        ' SQL上のデータ型に変換
        Dim sqlDataType As String = GetSqlDataType(データ型)

        ' SQL文の作成（ALTER TABLE テーブル名 ADD COLUMN 列名 型）
        Dim sql As String = $"ALTER TABLE [{テーブル名}] ADD COLUMN [{列名}] {sqlDataType}"

        Using conn As New OleDbConnection(connStr)
            Try
                conn.Open()
                Using cmd As New OleDbCommand(sql, conn)
                    cmd.ExecuteNonQuery()
                End Using
                Console.WriteLine("列が正常に追加されました。")
            Catch ex As Exception
                MsgBox("エラーが発生しました: " & ex.Message)
            End Try
        End Using
    End Sub
    '' <summary>
    '' 引数の文字列をAccess SQLのデータ型キーワードに変換します。
    '' 列を追加(dbPath As String, テーブル名 As String,列名 As String, データ型 As String)から呼び出される
    '' </summary>
    Private Function GetSqlDataType(dataType As String) As String
        Select Case dataType.ToLower()
            Case "string", "文字型", "テキスト"
                Return "LONGTEXT" ' または VARCHAR(255)
            Case "double", "数値", "実数"
                Return "DOUBLE"
            Case "integer", "整数"
                Return "INTEGER"
            Case "date", "日付"
                Return "DATETIME"
            Case "boolean", "真偽値"
                Return "YESNO"
            Case Else
                Return "VARCHAR(255)"
        End Select
    End Function

#End Region

#Region "DB ImportExce ExportExcel"
    Public Sub ImportExcelToAccess(MyDB As String, MyTable As String, MyExcel As String, MySheet As String)
        Dim dbPath As String = MyDB
        Dim excelPath As String = MyExcel
        Dim tableName As String = MyTable

        ' CreateObjectを使用してインスタンス化（他のメソッドと統一）
        Dim accessApp As Access.Application = DirectCast(CreateObject("Access.Application"), Access.Application)

        Try
            ' データベースを排他モードで開く
            accessApp.OpenCurrentDatabase(dbPath)

            ' 1. 同名テーブルが既にある場合は削除（リフレッシュするため）
            Try
                accessApp.DoCmd.DeleteObject(Access.AcObjectType.acTable, tableName)
            Catch
                ' テーブルが存在しないエラーは無視
            End Try

            ' 2. Excelインポート実行
            ' acImport: インポート, acSpreadsheetTypeExcel12Xml: .xlsx, True: 1行目をヘッダーとする
            accessApp.DoCmd.TransferSpreadsheet(
                Access.AcDataTransferType.acImport,
                Access.AcSpreadSheetType.acSpreadsheetTypeExcel12Xml,
                tableName,
                excelPath,
                HasFieldNames:=True
            )

            Console.WriteLine($"テーブル [{tableName}] の作成とインポートが完了しました。")

        Catch ex As Exception
            Console.WriteLine("実行エラー: " & ex.Message)
        Finally
            accessApp.Quit()
            System.Runtime.InteropServices.Marshal.ReleaseComObject(accessApp)
        End Try
    End Sub

#End Region

#Region "Access Query・Table削除 サーチ等”
    Public Sub DEL_Query(ByVal Query名 As String)

        '呼び出し例 DEL_Query(Q12＊）ー－＞Q12ｘｘｘはすべて削除

        'MsgBox(Query名)
        Dim cn As ADODB.Connection = DirectCast(CreateObject("ADODB.Connection"), ADODB.Connection)
        Dim cat As ADOX.Catalog
        Dim viw As ADOX.View
        'Dim tbl As ADOX.Table
        cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" + "Data Source=" + MyDB + ";"
        cn.Open()
        cat = DirectCast(CreateObject("ADOX.Catalog"), ADOX.Catalog)
        cat.let_ActiveConnection(cn)  ' cn は ADODB.Connection オブジェクト

        Dim h(50) As String
        Dim f As Integer = 0
        Dim i As Integer = 0
        Dim L = Query名.Length
        If InStr(Query名, "*") >= 2 Then
            L = InStr(Query名, "*") - 1
            Query名 = Strings.Left(Query名, L)
        End If


        For Each viw In cat.Views
            If Strings.Left(viw.Name, L) = Query名 Then
                f += 1 : h(f) = viw.Name           'クエリー検索
            End If
        Next viw

        'For Each tbl In cat.Tables
        '    If tbl.Type = "TABLE" Then
        '        .Items.Add(tbl.Name)        'テーブル検索
        '    End If
        'Next


        For i = 1 To f
            cn.Execute("DROP VIEW " & h(i) & "") 'クエリー削除
        Next

        If cat IsNot Nothing Then
            Try
                System.Runtime.InteropServices.Marshal.ReleaseComObject(cat)
            Catch
            End Try
            cat = Nothing
        End If
        cn.Close()
        If cn IsNot Nothing Then
            Try
                System.Runtime.InteropServices.Marshal.ReleaseComObject(cn)
            Catch
            End Try
            cn = Nothing
        End If

    End Sub

    Public Sub DEL_table(ByVal Table名 As String)

        '呼び出し例 DEL_table(Ｔ12*）ー－＞Ｔ12ｘｘｘはすべて削除

        Dim cn As ADODB.Connection = Nothing
        Dim cat As ADOX.Catalog = Nothing
        If Table名 Is Nothing Then Return
        Dim a As String = If(Table名.Length >= 2, Table名.Substring(0, 2), Table名)
        If a = "MS" Or a = "ms" Then
            MsgBox("システムテーブルは削除不可")
            Return
        End If

        Try
            cn = New ADODB.Connection()
            cn.Open("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyDB & ";")
            cat = New ADOX.Catalog()
            cat.let_ActiveConnection(cn)

            Dim L As Integer = If(Table名.Contains("*"), Table名.IndexOf("*"), Table名.Length)
            Dim prefix As String = Table名.Substring(0, L)

            ' 逆順で削除（インデックス変動対策）
            For i As Integer = cat.Tables.Count - 1 To 0 Step -1
                Dim tblName As String = cat.Tables(i).Name
                If tblName.StartsWith(prefix) Then
                    ' ADODB.Connection 経由で DROP TABLE 実行（安全）
                    cn.Execute("DROP TABLE [" & tblName & "]")
                End If
            Next
        Catch ex As Exception
            MessageBox.Show("DEL_table エラー: " & ex.Message)
        Finally
            Try
                If cn IsNot Nothing AndAlso cn.State = 1 Then cn.Close()
            Catch
            End Try
            ReleaseCom(cat)
            ReleaseCom(cn)
            GC.Collect()
            GC.WaitForPendingFinalizers()
        End Try
    End Sub
    ''' <summary>
    ''' COMオブジェクトを安全に解放します。
    ''' </summary>
    Private Sub ReleaseCom(ByVal obj As Object)
        Try
            If obj IsNot Nothing AndAlso System.Runtime.InteropServices.Marshal.IsComObject(obj) Then
                System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj)
            End If
        Catch
        Finally
            obj = Nothing
        End Try
    End Sub


    Public Function Search_Table(ByVal Table名 As String) As Boolean
        Dim a As String = Table名.Substring(0, 2)
        If a = "MS" Or a = "ms" Then
            MsgBox("システムテーブルは対象外")
            Return False
        End If

        Dim ADOXDBCon As ADOX.Catalog = Nothing
        Try
            ADOXDBCon = New ADOX.Catalog()
            ' 修正: let_ActiveConnection メソッドを使用
            ADOXDBCon.let_ActiveConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyDB & ";")

            Dim i As Integer = 0
            Dim L As Integer = Table名.Length

            If a.Contains("*") = True Then
                If InStr(Table名, "*") >= 2 Then
                    L = InStr(Table名, "*") - 1
                    Table名 = Strings.Left(Table名, L)
                End If
                For i = 0 To ADOXDBCon.Tables.Count - 1
                    If Strings.Left(ADOXDBCon.Tables(i).Name, L) = Table名 Then
                        Return True
                    End If
                Next
            End If

            If a.Contains("*") = False Then
                For i = 0 To ADOXDBCon.Tables.Count - 1
                    If Table名 = ADOXDBCon.Tables(i).Name Then
                        Return True
                    End If
                Next
            End If

            Return False
        Catch ex As Exception
            MsgBox("Search_Table エラー: " & ex.Message)
            Return False
        Finally
            ' COM オブジェクトの適切な解放
            ReleaseCom(ADOXDBCon)
        End Try
    End Function

    ' EnsureColumnExists removed: direct ALTER TABLE attempts are used instead per user's preference


#End Region

#Region "  SQL実行”
    Public Sub Sqlcommands_Add(sqlCommands As List(Of String))
        Dim cn As System.Data.OleDb.OleDbConnection =
                  New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyDB & ";")
        Dim Com As System.Data.OleDb.OleDbCommand = New OleDb.OleDbCommand()
        Com.Connection = cn
        cn.Open()
        Com.Transaction = cn.BeginTransaction
        Try
            Dim i1 As Integer
            For i1 = 0 To sqlCommands.Count - 1
                Com.CommandText = sqlCommands(i1)
                Com.ExecuteNonQuery()
            Next
            Com.Transaction.Commit()
        Catch ex As Exception
            MessageBox.Show(ex.Message)
            Com.Transaction.Rollback()
        Finally
            cn.Close()
        End Try

    End Sub
    Public Sub SQL実行(ByVal MySql As String)
        ' 実行専用：UPDATE/INSERT/DELETE などの非クエリを正しく実行するため ExecuteNonQuery を使用します。
        Using con As New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & MyDB & ";")
            Using cmd As New OleDb.OleDbCommand(MySql, con)
                cmd.CommandType = CommandType.Text
                Try
                    con.Open()
                    Dim affected As Integer = cmd.ExecuteNonQuery()
                    ' 影響行数をログ出力（デバッグ用）。必要なければ削除可。
                    ' Debug.WriteLine($"SQL実行: {MySql} -> {affected} 行")
                Catch ex As Exception
                    Try
                        MessageBox.Show("SQL実行エラー: " & ex.Message & vbCrLf & "SQL: " & MySql)
                    Catch
                    End Try
                    Throw
                End Try
            End Using
        End Using
    End Sub



#End Region

    Public Sub T800_計算対象作成1(E採用判定値 As Double, I採用判定値 As Double) 'E採用判定値<=1 And I採用判定値<=1の時

        'T160_IからT760_I作成
        MySQL = "SELECT T160_全出荷I集計.[アイテム], T160_全出荷I集計.乱数, IIf([T160_全出荷I集計]![乱数]<=" & I採用判定値 & ",'Yes','No') AS 判定 INTO T760_全出荷I集計 FROM T160_全出荷I集計;"
        SQL実行(MySQL)

        'T160_EからT760_E作成
        MySQL = "SELECT T160_全出荷E集計.出荷先, T160_全出荷E集計.乱数, IIf([T160_全出荷E集計]![乱数]<=" & E採用判定値 & ",'Yes','No') AS 判定 INTO T760_全出荷E判定 FROM T160_全出荷E集計;"
        SQL実行(MySQL)

        'T800作成
        MySQL = "SELECT NULL AS GPLEランク, NULL AS GPLIランク, T200.出荷先, T200.[アイテム], T200.G行, T200.Gバ, T200.Gケ, T200.GPL, T200.G容, T200.G重 INTO T800_計算対象 FROM (T760_全出荷E判定 INNER JOIN T200 ON T760_全出荷E判定.出荷先 = T200.出荷先) INNER JOIN T760_全出荷I集計 ON T200.[アイテム] = T760_全出荷I集計.[アイテム] WHERE (((T760_全出荷E判定.判定) = 'Yes') AND ((T760_全出荷I集計.判定) = 'Yes'));"
        SQL実行(MySQL)
    End Sub

    Public Sub T800_計算対象作成2(E採用判定値 As Double, I採用判定値 As Double) 'E採用判定値>1 And I採用判定値<=1の時
        'T160_IからT760_I作成
        MySQL = "SELECT T160_全出荷I集計.[アイテム], T160_全出荷I集計.乱数, IIf([T160_全出荷I集計]![乱数]<=" & I採用判定値 & ",'Yes','No') AS 判定 INTO T760_全出荷I集計 FROM T160_全出荷I集計;"
        SQL実行(MySQL)

        'T160_EからT760_E作成
        MySQL = "SELECT T160_全出荷E集計.出荷先, T160_全出荷E集計.乱数, IIf([T160_全出荷E集計]![乱数]<=" & E採用判定値 & ",'Yes','No') AS 判定 INTO T760_全出荷E判定 FROM T160_全出荷E集計;"
        SQL実行(MySQL)

        'T750_計算対象ダミー作成
        MySQL = "SELECT T200.行連番, T200.GPLEランク, T200.GPLIランク, [T200]![出荷先] & 'A' AS 出荷先, T200.[アイテム], T200.G行, T200.Gバ, T200.Gケ, T200.GPL, T200.G容, T200.G重 INTO T780_計算対象ダミー FROM T760_全出荷E判定 LEFT JOIN T200 ON T760_全出荷E判定.出荷先 = T200.出荷先 WHERE (((T760_全出荷E判定.判定)='Yes'));"
        SQL実行(MySQL)
        'T800作成
        MySQL = "SELECT T780_計算対象ダミー.行連番, T780_計算対象ダミー.GPLEランク, T780_計算対象ダミー.GPLIランク, T780_計算対象ダミー.出荷先, T780_計算対象ダミー.[アイテム], T780_計算対象ダミー.G行, T780_計算対象ダミー.Gバ, T780_計算対象ダミー.Gケ, T780_計算対象ダミー.GPL, T780_計算対象ダミー.G容, T780_計算対象ダミー.G重 INTO T800_計算対象 FROM T760_全出荷I集計 INNER JOIN T780_計算対象ダミー ON T760_全出荷I集計.[アイテム] = T780_計算対象ダミー.[アイテム] WHERE (((T760_全出荷I集計.判定)='Yes'));"
        SQL実行(MySQL)
        'T800作成にT200追加
        MySQL = "INSERT INTO T800_計算対象 ( GPLEランク, GPLIランク, 行連番, 出荷先, アイテム, G行, Gバ, Gケ, GPL, G容, G重 ) SELECT T200.GPLEランク, T200.GPLIランク, T200.行連番, T200.出荷先, T200.[アイテム], T200.G行, T200.Gバ, T200.Gケ, T200.GPL, T200.G容, T200.G重 FROM T200;"
        SQL実行(MySQL)
    End Sub


    Public Sub T800_計算対象作成3(E採用判定値 As Double, I採用判定値 As Double) 'E採用判定値<=1 And I採用判定値>1の時

        'T160_EからT760_E作成
        MySQL = "SELECT T160_全出荷E集計.出荷先, T160_全出荷E集計.乱数, IIf([T160_全出荷E集計]![乱数]<=" & E採用判定値 & ",'Yes','No') AS 判定 INTO T760_全出荷E判定 FROM T160_全出荷E集計;"
        SQL実行(MySQL)

        'T160_IからT760_I作成
        MySQL = "SELECT T160_全出荷I集計.アイテム, T160_全出荷I集計.乱数, IIf([T160_全出荷I集計]![乱数]<=" & I採用判定値 & ",'Yes','No') AS 判定 INTO T760_全出荷I判定 FROM T160_全出荷I集計;"
        SQL実行(MySQL)

        'T780_計算対象ダミー作成
        MySQL = "SELECT T200.行連番, T200.GPLEランク, T200.GPLIランク, T200.出荷先, [T200]![アイテム] & 'A' AS アイテム, T200.G行, T200.Gバ, T200.Gケ, T200.GPL, T200.G容, T200.G重 INTO T780_計算対象ダミー FROM T760_全出荷I判定 LEFT JOIN T200 ON T760_全出荷I判定.アイテム = T200.アイテム WHERE (((T760_全出荷I判定.判定)='Yes'));"
        SQL実行(MySQL)
        'T800作成
        MySQL = "SELECT T780_計算対象ダミー.行連番, T780_計算対象ダミー.GPLEランク, T780_計算対象ダミー.GPLIランク, T780_計算対象ダミー.出荷先, T780_計算対象ダミー.[アイテム], T780_計算対象ダミー.G行, T780_計算対象ダミー.Gバ, T780_計算対象ダミー.Gケ, T780_計算対象ダミー.GPL, T780_計算対象ダミー.G容, T780_計算対象ダミー.G重 INTO T800_計算対象 FROM T760_全出荷I判定 INNER JOIN T780_計算対象ダミー ON T760_全出荷I判定.[アイテム] = T780_計算対象ダミー.[アイテム] WHERE (((T760_全出荷I判定.判定)='Yes'));"
        SQL実行(MySQL)
        'T800作成にT200追加
        MySQL = "INSERT INTO T800_計算対象 ( GPLEランク, GPLIランク, 行連番, 出荷先, アイテム, G行, Gバ, Gケ, GPL, G容, G重 ) SELECT T200.GPLEランク, T200.GPLIランク, T200.行連番, T200.出荷先, T200.[アイテム], T200.G行, T200.Gバ, T200.Gケ, T200.GPL, T200.G容, T200.G重 FROM T200;"
        SQL実行(MySQL)
    End Sub
End Module
